home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / COMMON / TOOLS / VCM / VCM.MDB / VcmComponentContainer / 01_Cabinet / CtlCfg.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-05-18  |  7.1 KB  |  218 lines
  1. VERSION 5.00
  2. Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDatGrd.Ocx"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.ocx"
  4. Begin VB.Form frmCtlCfg 
  5.    Caption         =   "Control Configuration Sample"
  6.    ClientHeight    =   7950
  7.    ClientLeft      =   165
  8.    ClientTop       =   735
  9.    ClientWidth     =   10545
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   9.75
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    LinkTopic       =   "Form1"
  20.    ScaleHeight     =   7950
  21.    ScaleWidth      =   10545
  22.    StartUpPosition =   3  'Windows Default
  23.    Begin MSComDlg.CommonDialog dlgFind 
  24.       Left            =   9000
  25.       Top             =   7440
  26.       _ExtentX        =   847
  27.       _ExtentY        =   847
  28.       _Version        =   393216
  29.    End
  30.    Begin MSDataGridLib.DataGrid grdControls 
  31.       Height          =   6855
  32.       Left            =   120
  33.       TabIndex        =   1
  34.       Top             =   480
  35.       Width           =   10095
  36.       _ExtentX        =   17806
  37.       _ExtentY        =   12091
  38.       _Version        =   393216
  39.       AllowUpdate     =   -1  'True
  40.       BackColor       =   -2147483633
  41.       HeadLines       =   1
  42.       RowHeight       =   15
  43.       TabAction       =   2
  44.       BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  45.          Name            =   "MS Sans Serif"
  46.          Size            =   8.25
  47.          Charset         =   0
  48.          Weight          =   700
  49.          Underline       =   0   'False
  50.          Italic          =   0   'False
  51.          Strikethrough   =   0   'False
  52.       EndProperty
  53.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  54.          Name            =   "MS Sans Serif"
  55.          Size            =   8.25
  56.          Charset         =   0
  57.          Weight          =   400
  58.          Underline       =   0   'False
  59.          Italic          =   0   'False
  60.          Strikethrough   =   0   'False
  61.       EndProperty
  62.       ColumnCount     =   2
  63.       BeginProperty Column00 
  64.          DataField       =   ""
  65.          Caption         =   ""
  66.          BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
  67.             Type            =   0
  68.             Format          =   ""
  69.             HaveTrueFalseNull=   0
  70.             FirstDayOfWeek  =   0
  71.             FirstWeekOfYear =   0
  72.             LCID            =   1024
  73.          EndProperty
  74.       EndProperty
  75.       BeginProperty Column01 
  76.          DataField       =   ""
  77.          Caption         =   ""
  78.          BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
  79.             Type            =   0
  80.             Format          =   ""
  81.             HaveTrueFalseNull=   0
  82.             FirstDayOfWeek  =   0
  83.             FirstWeekOfYear =   0
  84.             LCID            =   1024
  85.          EndProperty
  86.       EndProperty
  87.       SplitCount      =   1
  88.       BeginProperty Split0 
  89.          BeginProperty Column00 
  90.          EndProperty
  91.          BeginProperty Column01 
  92.          EndProperty
  93.       EndProperty
  94.    End
  95.    Begin VB.Label lblInfo 
  96.       Appearance      =   0  'Flat
  97.       AutoSize        =   -1  'True
  98.       BorderStyle     =   1  'Fixed Single
  99.       Caption         =   $"CtlCfg.frx":0000
  100.       BeginProperty Font 
  101.          Name            =   "MS Sans Serif"
  102.          Size            =   8.25
  103.          Charset         =   0
  104.          Weight          =   400
  105.          Underline       =   0   'False
  106.          Italic          =   0   'False
  107.          Strikethrough   =   0   'False
  108.       EndProperty
  109.       ForeColor       =   &H8000000D&
  110.       Height          =   435
  111.       Left            =   0
  112.       TabIndex        =   0
  113.       Top             =   0
  114.       Width           =   10245
  115.       WordWrap        =   -1  'True
  116.    End
  117.    Begin VB.Menu mnuFile 
  118.       Caption         =   "&File"
  119.       Begin VB.Menu mnuSave 
  120.          Caption         =   "&Save"
  121.          Shortcut        =   ^S
  122.       End
  123.       Begin VB.Menu mnuExit 
  124.          Caption         =   "E&xit"
  125.       End
  126.    End
  127.    Begin VB.Menu mnuEdit 
  128.       Caption         =   "&Edit"
  129.       Begin VB.Menu mnuNewEntry 
  130.          Caption         =   "&New Entry"
  131.          Shortcut        =   ^N
  132.       End
  133.       Begin VB.Menu mnuDeleteEntry 
  134.          Caption         =   "&Delete Entry"
  135.          Shortcut        =   ^D
  136.       End
  137.    End
  138. Attribute VB_Name = "frmCtlCfg"
  139. Attribute VB_GlobalNameSpace = False
  140. Attribute VB_Creatable = False
  141. Attribute VB_PredeclaredId = True
  142. Attribute VB_Exposed = False
  143. Option Explicit
  144. Dim rsControls As New ADODB.Recordset
  145. Dim cnControls As New ADODB.Connection
  146. Private Sub Form_Load()
  147.     On Error GoTo FindErr
  148.     Dim strQ As String
  149.     strQ = "provider=Microsoft.Jet.OLEDB.3.51;data source=" & App.Path & "\controls.mdb"
  150.     cnControls.Open strQ
  151.     rsControls.Open "select * from controls order by description", cnControls, adOpenKeyset, adLockOptimistic
  152.     Set grdControls.DataSource = rsControls
  153.     Exit Sub
  154. FindErr:
  155.     ' If the database isn't found, use the FindDB function to find it.
  156.     If Err.Number = -2147467259 Then
  157.     cnControls.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data source=" & FindDB("controls.mdb")
  158.     Resume Next
  159.     End If
  160.     Exit Sub
  161. End Sub
  162. Private Function FindDB(dbName As String) As String
  163.     On Error GoTo ErrHandler
  164.     ' Configure cmdDialog in case the database can't be found.
  165.     With dlgFind
  166.         .DialogTitle = "Can't Find " & dbName
  167.         .Filter = "(*.MDB)|*.mdb"
  168.         .CancelError = True   'Causes an error if user clicks on cancel
  169.         .ShowOpen
  170.     End With
  171.     ' Test the string to ensure it's the sought database.
  172.     Do While Right(Trim(dlgFind.FileName), Len(dbName)) <> dbName
  173.        MsgBox "File Name is not equal to " & dbName
  174.        dlgFind.ShowOpen
  175.     Loop
  176.     FindDB = dlgFind.FileName ' return the full path.
  177.     Exit Function
  178. ErrHandler:
  179.     Select Case Err.Number
  180.     Case 32755
  181.       Unload Me
  182.     Case Else
  183.         MsgBox Err.Number & ": " & Err.Description
  184.     End Select
  185. End Function
  186. Private Sub Form_Resize()
  187.   lblInfo.Width = ScaleWidth
  188.   grdControls.Move 0, lblInfo.Height, ScaleWidth, ScaleHeight - lblInfo.Height
  189. End Sub
  190. Private Sub grdControls_Error(ByVal DataError As Integer, Response As Integer)
  191.   Response = 0
  192. End Sub
  193. Private Sub mnuDeleteEntry_Click()
  194.   rsControls.Delete
  195. End Sub
  196. Private Sub mnuExit_Click()
  197.     Unload Me
  198. End Sub
  199. Private Sub mnuNewEntry_Click()
  200.   rsControls.AddNew
  201. End Sub
  202. Private Sub mnuSave_Click()
  203.   Dim vControlLicense As Variant
  204.   Dim sControlType As String
  205.   On Error Resume Next
  206.   rsControls.MoveFirst
  207.   While Not rsControls.EOF
  208.     vControlLicense = Null
  209.     sControlType = rsControls.Fields("ControlType")
  210.     vControlLicense = Licenses.Add(sControlType)
  211.     Licenses.Remove sControlType
  212.     rsControls.Fields("ControlLicense") = vControlLicense
  213.     rsControls.MoveNext
  214.   Wend
  215.   rsControls.Update
  216.   rsControls.MoveFirst
  217. End Sub
  218.